home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / FROMUTS / XLISP1 / !XLisp / c / XLSTR < prev    next >
Text File  |  1990-02-23  |  3KB  |  132 lines
  1. /* xlstr - xlisp string builtin functions */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. /* external variables */
  9. extern NODE ***xlstack;
  10. extern char buf[];
  11.  
  12. /* external procedures */
  13. extern char *strcat();
  14.  
  15. /* xstrcat - concatenate a bunch of strings */
  16. NODE *xstrcat(args)
  17.   NODE *args;
  18. {
  19.     NODE ***oldstk,*val,*p;
  20.     char *str;
  21.     int len;
  22.  
  23.     /* create a new stack frame */
  24.     oldstk = xlsave(&val,(NODE **)NULL);
  25.  
  26.     /* find the length of the new string */
  27.     for (p = args, len = 0; p; )
  28.     len += strlen(getstring(xlmatch(STR,&p)));
  29.  
  30.     /* create the result string */
  31.     val = newstring(len);
  32.     str = getstring(val);
  33.     *str = 0;
  34.  
  35.     /* combine the strings */
  36.     while (args)
  37.     strcat(str,getstring(xlmatch(STR,&args)));
  38.  
  39.     /* restore the previous stack frame */
  40.     xlstack = oldstk;
  41.  
  42.     /* return the new string */
  43.     return (val);
  44. }
  45.  
  46. /* xsubstr - return a substring */
  47. NODE *xsubstr(args)
  48.   NODE *args;
  49. {
  50.     NODE ***oldstk,*arg,*src,*val;
  51.     int start,forlen,srclen;
  52.     char *srcptr,*dstptr;
  53.  
  54.     /* create a new stack frame */
  55.     oldstk = xlsave(&arg,&src,&val,(NODE **)NULL);
  56.  
  57.     /* initialize */
  58.     arg = args;
  59.  
  60.     /* get string and its length */
  61.     src = xlmatch(STR,&arg);
  62.     srcptr = getstring(src);
  63.     srclen = strlen(srcptr);
  64.  
  65.     /* get starting pos -- must be present */
  66.     start = getfixnum(xlmatch(INT,&arg));
  67.  
  68.     /* get length -- if not present use remainder of string */
  69.     forlen = (arg ? getfixnum(xlmatch(INT,&arg)) : srclen);
  70.  
  71.     /* make sure there aren't any more arguments */
  72.     xllastarg(arg);
  73.  
  74.     /* don't take more than exists */
  75.     if (start + forlen > srclen)
  76.     forlen = srclen - start + 1;
  77.  
  78.     /* if start beyond string -- return null string */
  79.     if (start > srclen) {
  80.     start = 1;
  81.     forlen = 0; }
  82.     
  83.     /* create return node */
  84.     val = newstring(forlen);
  85.     dstptr = getstring(val);
  86.  
  87.     /* move string */
  88.     for (srcptr += start-1; forlen--; *dstptr++ = *srcptr++)
  89.     ;
  90.     *dstptr = 0;
  91.  
  92.     /* restore the previous stack frame */
  93.     xlstack = oldstk;
  94.  
  95.     /* return the substring */
  96.     return (val);
  97. }
  98.  
  99. /* xstring - return a string consisting of a single character */
  100. NODE *xstring(args)
  101.   NODE *args;
  102. {
  103.     /* get the character (integer) */
  104.     buf[0] = getfixnum(xlmatch(INT,&args));
  105.     xllastarg(args);
  106.  
  107.     /* make a one character string */
  108.     buf[1] = 0;
  109.     return (cvstring(buf));
  110. }
  111.  
  112. /* xchar - extract a character from a string */
  113. NODE *xchar(args)
  114.   NODE *args;
  115. {
  116.     char *str;
  117.     int n;
  118.  
  119.     /* get the string and the index */
  120.     str = getstring(xlmatch(STR,&args));
  121.     n = getfixnum(xlmatch(INT,&args));
  122.     xllastarg(args);
  123.  
  124.     /* range check the index */
  125.     if (n < 0 || n >= strlen(str))
  126.     xlerror("index out of range",cvfixnum((FIXNUM)n));
  127.  
  128.     /* return the character */
  129.     return (cvfixnum((FIXNUM)str[n]));
  130. }
  131.  
  132.